PC Action 1997 January/PCA0197.ISO/demos/ambe/roxy/roxy.dxr/02750_final import-cast handler...TEST!!.ls

Text File | 1996-10-28 | 12.3 KB | 365 lines

on FinalImportAll confirmation
  if the paramCount < 1 then
    alert("Do you REALLY want to import all cast? If so, type 'FinalImportAll REALLY'...")
    exit
  end if
  put "confirmation:"
  put confirmation
  set the colorDepth to 8
  updateStage()
  put "I've set the colordepth to 256 colors..."
  if confirmation <> "REALLY" then
    alert("Do you REALLY want to import all cast? If so, type 'FinalImportAll REALLY'...")
    exit
  end if
  repeat with i = 1 to the number of castMembers
    if the mouseDown then
      exit
    end if
    if the freeBlock < 2000000 then
      saveMovie("BigDog")
      unLoadCast()
    end if
    if the fileName of cast i <> EMPTY then
      if the castType of cast i = #bitmap then
        set myName to the name of cast i
        set myScript to the scriptText of cast i
        set myRegPt to the regPoint of cast i
        set myPurgePriority to the purgePriority of cast i
        set myPalette to the palette of cast i
        puppetPalette(myPalette, 60)
        updateStage()
        importFileInto(cast i, the fileName of cast i)
        set the name of cast i to myName
        set the scriptText of cast i to myScript
        set the regPoint of cast i to myRegPt
        set the purgePriority of cast i to myPurgePriority
        set the palette of cast i to myPalette
        put "Imported PICT cast number " & i & "," && the name of cast i & "," & " sucessfully."
      end if
    end if
    if the fileName of cast i <> EMPTY then
      if the castType of cast i = #sound then
        set myName to the name of cast i
        set myScript to the scriptText of cast i
        set myPurgePriority to the purgePriority of cast i
        importFileInto(cast i, the fileName of cast i)
        set the name of cast i to myName
        set the scriptText of cast i to myScript
        set the purgePriority of cast i to myPurgePriority
        put "Imported Sound cast number " & i & "," && the name of cast i & "," & " sucessfully."
      end if
    end if
    if the fileName of cast i <> EMPTY then
      if the castType of cast i = #movie then
        set myName to the name of cast i
        set myScript to the scriptText of cast i
        set myPurgePriority to the purgePriority of cast i
        importFileInto(cast i, the fileName of cast i)
        set the name of cast i to myName
        set the scriptText of cast i to myScript
        set the purgePriority of cast i to myPurgePriority
        put "Imported Director movie cast number " & i & "," && the name of cast i & "," & " sucessfully."
      end if
    end if
  end repeat
  set date to the short date
  set time to the short time
  set dateTime to date & "," & time
  put "Errors or non-imports on these cast:"
  repeat with i = 1 to the number of castMembers
    if the fileName of cast i <> EMPTY then
      put the name of cast i
    end if
  end repeat
end

on replaceFromFolder folderName, newPalNumber
  if not integerp(newPalNumber) then
    alert("Sorry, you've gotta tell me the new palette number in param2..")
    exit
  end if
  if the castType of cast newPalNumber <> #palette then
    alert("Sorry, cast " & newPalNumber & " isn't a palette castmember..")
    exit
  end if
  set the colorDepth to 8
  if the colorDepth <> 8 then
    alert("Sorry, the colordepth needs to be 8-bit for this to work")
    exit
  end if
  set fileList to []
  set tempList to []
  repeat with i = 1 to the maxinteger
    set n to getNthFileNameInFolder(the pathName & folderName & ":", i)
    if n = EMPTY then
      exit repeat
    end if
    append(fileList, n)
    append(tempList, n)
  end repeat
  put "fileList = " & fileList
  put "tempList = " & tempList
  put "fileList = tempList?  " & fileList = tempList
  repeat with currentFile in tempList
    if the freeBlock < 2000000 then
      put "   <i> Hold on a minute, I'm low on space and saving.."
      saveMovie()
      put "    OK, back in action..."
    end if
    set lowestCast to 800
    set highestCast to 2500
    repeat with i = lowestCast to highestCast
      if the name of cast i = currentFile then
        puppetPalette(newPalNumber)
        updateStage()
        set myName to the name of cast i
        set myScript to the scriptText of cast i
        set myRegPt to the regPoint of cast i
        set myPurgePriority to the purgePriority of cast i
        set myPalette to newPalNumber
        set myHeight to the height of cast i
        set myWidth to the width of cast i
        importFileInto(cast i, the pathName & folderName & ":" & the name of cast i)
        set the name of cast i to myName
        set the scriptText of cast i to myScript
        set the regPoint of cast i to myRegPt
        set the purgePriority of cast i to myPurgePriority
        set the palette of cast i to myPalette
        put "Imported cast number " & i & "," && the name of cast i & "," & " sucessfully."
        if (myWidth <> the width of cast i) or (myHeight <> the height of cast i) then
          beep()
          put "<!> NOTE that height or width of cast " & i & " (" & the name of cast i & ") has changed..."
        end if
        deleteAt(fileList, getPos(fileList, currentFile))
        exit repeat
      end if
    end repeat
    if i = (highestCast + 1) then
      put "ΓÇóΓÇóΓÇó <!>  failed to find match for file " & currentFile
    end if
  end repeat
  put "Errors or non-imports on these cast:"
  repeat with i in fileList
    put i
  end repeat
end

on importFolder folderName
  set oldDelim to the itemDelimiter
  put "old delimiter was " & oldDelim
  set the itemDelimiter to ":"
  set fileList to []
  set tempList to []
  repeat with i = 1 to the maxinteger
    set n to getNthFileNameInFolder(the pathName & folderName & ":", i)
    if n = EMPTY then
      exit repeat
    end if
    append(fileList, n)
    append(tempList, n)
  end repeat
  put "fileList = " & fileList
  put "tempList = " & tempList
  put "fileList = tempList?  " & fileList = tempList
  repeat with currentFile in tempList
    if the freeBlock < 2000000 then
      saveMovie("BigDog")
      put "Wow, I just had to save that one (as 'BigDog')..."
    end if
    put currentFile
    repeat with i = 1239 to 1340
      if the last item in the fileName of cast i = currentFile then
        puppetPalette(the palette of cast i)
        updateStage()
        set myName to the name of cast i
        set myScript to the scriptText of cast i
        set myRegPt to the regPoint of cast i
        set myPurgePriority to the purgePriority of cast i
        set myPalette to the palette of cast i
        erase(member i)
        importFileInto(cast i, the fileName of cast i)
        set the name of cast i to myName
        set the scriptText of cast i to myScript
        set the regPoint of cast i to myRegPt
        set the purgePriority of cast i to myPurgePriority
        set the palette of cast i to myPalette
        put "Imported cast number " & i & "," && the name of cast i & "," & " sucessfully."
        deleteAt(fileList, getPos(fileList, currentFile))
        exit repeat
      end if
    end repeat
    if i = 1340 then
      put "failed to find match for file " & currentFile
      next repeat
    end if
    put "found match for " & currentFile
  end repeat
  set the itemDelimiter to oldDelim
  put "Errors or non-imports on these cast:"
  repeat with i in fileList
    put i
  end repeat
end

on findAssignedPalette whichPalette
  if stringp(whichPalette) then
    set whichPalette to the number of member whichPalette
  end if
  put EMPTY
  put "The following castmembers use palette " & whichPalette & " (" & the name of cast whichPalette & ")"
  repeat with i = 1 to the number of castMembers
    if the castType of cast i = #bitmap then
      if the palette of cast i = whichPalette then
        put the name of cast i & " (number " & i & ")"
      end if
    end if
  end repeat
  put EMPTY
end

on reportPalettes
  put EMPTY
  put "ΓÇóΓÇóΓÇó PALETTE REPORT ΓÇóΓÇóΓÇó"
  set howManyPalettes to 0
  repeat with i = 1 to the number of castMembers
    if the castType of cast i = #palette then
      set howManyPalettes to howManyPalettes + 1
      put the name of cast i & " (cast " & i & ")"
      set loyalCast to 0
      repeat with j = 1 to the number of castMembers
        if the castType of cast j = #bitmap then
          if the palette of cast j = i then
            set loyalCast to loyalCast + 1
          end if
        end if
      end repeat
      put "  used by " & loyalCast & " bitmap castmembers"
    end if
  end repeat
  put "ΓÇóΓÇóΓÇó TOTAL: " & howManyPalettes & " custom palettes in cast ΓÇóΓÇóΓÇó"
end

on changePalsFromFolder folderName, testFlag
  set firstDomainBitmap to 550
  set lastDomainBitmap to 2300
  set temporaryCast to findEmpty(cast 1000)
  put "temporaryCast = " & temporaryCast
  if the colorDepth <> 8 then
    alert("Hey, this really only works in 8-bit color..")
    exit
  end if
  set oldDelim to the itemDelimiter
  put "old delimiter was " & oldDelim
  set the itemDelimiter to ":"
  set fileList to []
  set tempList to []
  repeat with i = 1 to the maxinteger
    set n to getNthFileNameInFolder(the pathName & folderName & ":", i)
    if n = EMPTY then
      exit repeat
    end if
    append(fileList, n)
    append(tempList, n)
  end repeat
  put "Searching folder '" & the pathName & folderName & ":'"
  put "fileList = " & fileList
  if testFlag = #test then
    exit
  end if
  if testFlag <> #really then
    alert("ΓÇóΓÇó Don't forget second param '#really' ΓÇóΓÇó")
    exit
  end if
  repeat with currentFile in tempList
    put currentFile
    repeat with i = firstDomainBitmap to lastDomainBitmap
      if (the last item in the fileName of cast i = currentFile) and (the castType of cast i = #bitmap) then
        importFileInto(cast temporaryCast, the pathName & folderName & ":" & currentFile)
        set newPaletteNumber to the palette of cast temporaryCast
        put "new palette = " & the name of cast newPaletteNumber & " (cast " & newPaletteNumber & ")"
        set the palette of cast i to newPaletteNumber
        puppetPalette(the palette of cast i)
        updateStage()
        put "Re-paletted cast " & i & "," && the name of cast i & "," & " sucessfully."
        deleteAt(fileList, getPos(fileList, currentFile))
        exit repeat
      end if
    end repeat
    if i = lastDomainBitmap then
      put "failed to find match for file " & currentFile
    end if
  end repeat
  duplicate(cast findEmpty(cast 1000), temporaryCast)
  set the itemDelimiter to oldDelim
  put "No match found (or non-bitmap?) for these files:"
  repeat with i in fileList
    put i
  end repeat
end

on lookForLinkedFiles
  repeat with i = 1 to the number of castMembers
    if the fileName of cast i <> EMPTY then
      put i & ":" & the name of cast i
    end if
  end repeat
end

on shiftPalettes palFolder, confirmation
  if not stringp(palFolder) then
    put "Sorry, you must specify a new-palettes folder in param 2."
    exit
  end if
  if param(3) <> #really then
    put "Sorry, you must confirm this operation with #really in param 3."
    exit
  end if
  set the colorDepth to 8
  if the colorDepth <> 8 then
    put "Sorry, couldn't switch the colordepth to 8... I'm bailing."
    exit
  end if
  set lsNewPalettes to []
  repeat with i = 1 to the maxinteger
    set n to getNthFileNameInFolder(the pathName & palFolder & ":", i)
    if n = EMPTY then
      exit repeat
    end if
    append(lsNewPalettes, n)
  end repeat
  put lsNewPalettes
  repeat with theFile in lsNewPalettes
    importFileInto(cast findEmpty(cast 4000), theFile)
  end repeat
  set oldPalettes to [:]
  sort(oldPalettes)
  repeat with cNum = 1 to 3999
    if the castType of cast cNum = #palette then
      set cName to the name of cast cNum
      if not voidp(getaProp(oldPalettes, cName)) then
        alert("Duplicate palette in cast:  '" & cName & "'")
      end if
      addProp(oldPalettes, cName, cNum)
    end if
  end repeat
  put "oldPalettes = " & oldPalettes
  set lsImagesByPalette to [#None: []]
  repeat with palNumber in oldPalettes
    addProp(lsImagesByPalette, palNumber, [])
  end repeat
  put "lsImagesByPalette = " & lsImagesByPalette
  repeat with cNum = 1 to 3999
    if the castType of cast cNum <> #bitmap then
      next repeat
    end if
    if the depth of cast cNum <> 8 then
      set myCohort to getProp(lsImagesByPalette, #None)
    else
      set myCohort to getProp(lsImagesByPalette, the palette of cast cNum)
    end if
    append(myCohort, cNum)
  end repeat
  put "lsImagesByPalette = " & lsImagesByPalette
end